indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 394)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.04703 13.04241 13.03784 13.03334 13.02890 13.02451 13.02017 13.01589
## [9] 13.01167 13.00750 13.00338 12.99931 12.99530 12.99133 12.98742 12.98355
## [17] 12.97973 12.97596 12.97223 12.96855 12.96491 12.96131 12.95776 12.95425
## [25] 12.95079 12.94736 12.94397 12.94062 12.93731 12.93404 12.93080 12.92759
## [33] 12.92443 12.92129 12.91819 12.91512 12.91209 12.90912 12.90619 12.90332
## [41] 12.90049 12.89772 12.89500 12.89233 12.88972 12.88716 12.88465 12.88219
## [49] 12.87979 12.87745 12.87516 12.87292 12.87074 12.86862 12.86655 12.86454
## [57] 12.86259 12.86069 12.85885 12.85707 12.85535 12.85369 12.85209 12.85054
## [65] 12.84906 12.84763 12.84627 12.84496 12.84372 12.84254 12.84142 12.84036
## [73] 12.83937 12.83844 12.83757 12.83677 12.83603 12.83535 12.83473 12.83418
## [81] 12.83368 12.83324 12.83285 12.83253 12.83226 12.83204 12.83189 12.83178
## [89] 12.83174 12.83174 12.83181 12.83192 12.83209 12.83232 12.83259 12.83292
## [97] 12.83330 12.83374 12.83422 12.83476 12.83535 12.83599 12.83668 12.83741
## [105] 12.83820 12.83904 12.83993 12.84086 12.84185 12.84288 12.84396 12.84508
## [113] 12.84626 12.84748 12.84874 12.85006 12.85141 12.85282 12.85426 12.85576
## [121] 12.85755 12.85986 12.86264 12.86585 12.86944 12.87336 12.87756 12.88199
## [129] 12.88661 12.89136 12.89621 12.90110 12.90598 12.91080 12.91553 12.92010
## [137] 12.92448 12.92861 12.93244 12.93594 12.93904 12.94171 12.94519 12.95064
## [145] 12.95786 12.96664 12.97677 12.98805 13.00027 13.01322 13.02671 13.04052
## [153] 13.05445 13.06829 13.08184 13.09489 13.10724 13.11868 13.12901 13.13801
## [161] 13.14550 13.15124 13.15506 13.15818 13.16198 13.16639 13.17134 13.17679
## [169] 13.18267 13.18892 13.19549 13.20231 13.20934 13.21650 13.22373 13.23099
## [177] 13.23821 13.24533 13.25230 13.25905 13.26553 13.27167 13.27742 13.28272
## [185] 13.28751 13.29173 13.29532 13.29822 13.30038 13.30174 13.30223 13.30180
## [193] 13.30039 13.29794 13.29439 13.28968 13.28363 13.27617 13.26741 13.25747
## [201] 13.24647 13.23451 13.22172 13.20820 13.19407 13.17945 13.16444 13.14917
## [209] 13.13374 13.11828 13.10289 13.08769 13.07280 13.05832 13.04438 13.03108
## [217] 13.01855 13.00456 12.98714 12.96673 12.94379 12.91879 12.89216 12.86437
## [225] 12.83587 12.80712 12.77857 12.75068 12.72389 12.69868 12.67548 12.65476
## [233] 12.63698 12.61989 12.60109 12.58076 12.55908 12.53624 12.51242 12.48779
## [241] 12.46255 12.43687 12.41094 12.38494 12.35905 12.33345 12.30833 12.28387
## [249] 12.26025 12.23765 12.21625 12.19625 12.17781 12.16113 12.14588 12.13156
## [257] 12.11810 12.10542 12.09343 12.08206 12.07122 12.06084 12.05084 12.04114
## [265] 12.03166 12.02231 12.01302 12.00371 11.99430 11.98471 11.97486 11.96467
## [273] 11.95406 11.94295 11.93126 11.91997 11.91003 11.90130 11.89367 11.88702
## [281] 11.88120 11.87611 11.87161 11.86758 11.86389 11.86042 11.85705 11.85364
## [289] 11.85008 11.84623 11.84198 11.83719 11.83174 11.82551 11.81837 11.81020
## [297] 11.80078 11.79010 11.77833 11.76564 11.75221 11.73821 11.72381 11.70919
## [305] 11.69452 11.67998 11.66573 11.65195 11.63881 11.62649 11.61515 11.60498
## [313] 11.59614 11.58881 11.58316 11.57830 11.57324 11.56803 11.56272 11.55736
## [321] 11.55200 11.54668 11.54146 11.53637 11.53149 11.52683 11.52247 11.51845
## [329] 11.51481 11.51160 11.50887 11.50668 11.50506 11.50407 11.50376 11.50417
## [337] 11.50535 11.50696 11.50863 11.51041 11.51232 11.51442 11.51673 11.51929
## [345] 11.52214 11.52532 11.52887 11.53282 11.53720 11.54207 11.54745 11.55338
## [353] 11.55974 11.56639 11.57332 11.58055 11.58807 11.59589 11.60403 11.61247
## [361] 11.62124 11.63032 11.63973 11.64948 11.65956 11.66998 11.68075 11.69187
## [369] 11.70334 11.71518 11.72738 11.73996 11.75291 11.76624 11.77995 11.79406
## [377] 11.80856 11.82346 11.83889 11.85496 11.87163 11.88888 11.90666 11.92496
## [385] 11.94374 11.96296 11.98260 12.00263 12.02301 12.04371 12.06471 12.08596
## [393] 12.10744 12.12912#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 394)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.58167 12.57874 12.57586 12.57305 12.57030 12.56760 12.56497 12.56240
## [9] 12.55989 12.55745 12.55507 12.55275 12.55050 12.54831 12.54619 12.54414
## [17] 12.54216 12.54024 12.53839 12.53662 12.53491 12.53328 12.53171 12.53022
## [25] 12.52881 12.52746 12.52619 12.52500 12.52388 12.52284 12.52188 12.52099
## [33] 12.52019 12.51946 12.51881 12.51825 12.51776 12.51735 12.51703 12.51678
## [41] 12.51660 12.51651 12.51649 12.51655 12.51668 12.51689 12.51717 12.51753
## [49] 12.51796 12.51847 12.51904 12.51969 12.52041 12.52120 12.52205 12.52298
## [57] 12.52398 12.52505 12.52618 12.52738 12.52865 12.52999 12.53139 12.53285
## [65] 12.53439 12.53598 12.53764 12.53936 12.54114 12.54299 12.54490 12.54687
## [73] 12.54890 12.55098 12.55313 12.55534 12.55760 12.55993 12.56240 12.56511
## [81] 12.56805 12.57122 12.57460 12.57820 12.58200 12.58599 12.59018 12.59455
## [89] 12.59909 12.60381 12.60868 12.61372 12.61890 12.62422 12.62968 12.63527
## [97] 12.64097 12.64680 12.65272 12.65875 12.66488 12.67109 12.67737 12.68374
## [105] 12.69016 12.69665 12.70319 12.70977 12.71640 12.72305 12.72973 12.73642
## [113] 12.74313 12.74984 12.75655 12.76325 12.76993 12.77658 12.78321 12.78980
## [121] 12.79634 12.80283 12.80927 12.81564 12.82194 12.82815 12.83429 12.84033
## [129] 12.84627 12.85210 12.85782 12.86342 12.86889 12.87423 12.87943 12.88448
## [137] 12.88937 12.89411 12.89867 12.90306 12.90809 12.91449 12.92210 12.93078
## [145] 12.94038 12.95074 12.96171 12.97315 12.98490 12.99682 13.00875 13.02054
## [153] 13.03205 13.04312 13.05361 13.06336 13.07222 13.08004 13.08667 13.09197
## [161] 13.09578 13.09942 13.10424 13.11013 13.11699 13.12470 13.13316 13.14227
## [169] 13.15191 13.16197 13.17236 13.18295 13.19365 13.20435 13.21494 13.22531
## [177] 13.23535 13.24496 13.25403 13.26245 13.27011 13.27692 13.28275 13.28750
## [185] 13.29107 13.29334 13.29421 13.29358 13.29132 13.28743 13.28197 13.27503
## [193] 13.26666 13.25692 13.24589 13.23363 13.22020 13.20567 13.19010 13.17356
## [201] 13.15612 13.13783 13.11877 13.09899 13.07857 13.05757 13.03605 13.01407
## [209] 12.99172 12.96904 12.94610 12.92297 12.89972 12.87641 12.85310 12.82985
## [217] 12.80675 12.78384 12.76119 12.73887 12.71695 12.69549 12.67455 12.65420
## [225] 12.63450 12.61553 12.59733 12.57999 12.56356 12.54811 12.53370 12.51929
## [233] 12.50385 12.48749 12.47034 12.45252 12.43414 12.41532 12.39618 12.37684
## [241] 12.35741 12.33801 12.31876 12.29978 12.28118 12.26309 12.24562 12.22888
## [249] 12.21301 12.19810 12.18429 12.17169 12.16050 12.15076 12.14232 12.13505
## [257] 12.12881 12.12347 12.11888 12.11492 12.11143 12.10828 12.10534 12.10247
## [265] 12.09954 12.09639 12.09290 12.08893 12.08433 12.07898 12.07274 12.06546
## [273] 12.05702 12.04813 12.03963 12.03148 12.02368 12.01620 12.00904 12.00217
## [281] 11.99558 11.98925 11.98317 11.97731 11.97168 11.96623 11.96097 11.95588
## [289] 11.95093 11.94612 11.94142 11.93682 11.93230 11.92785 11.92345 11.91909
## [297] 11.91474 11.91039 11.90603 11.90164 11.89721 11.89270 11.88812 11.88345
## [305] 11.87866 11.87374 11.86868 11.86345 11.85805 11.85246 11.84638 11.83961
## [313] 11.83223 11.82434 11.81602 11.80738 11.79849 11.78947 11.78038 11.77134
## [321] 11.76242 11.75372 11.74534 11.73735 11.72987 11.72297 11.71675 11.71131
## [329] 11.70672 11.70309 11.70051 11.69844 11.69631 11.69413 11.69195 11.68980
## [337] 11.68769 11.68566 11.68374 11.68196 11.68034 11.67891 11.67771 11.67676
## [345] 11.67610 11.67574 11.67572 11.67607 11.67681 11.67798 11.67960 11.68171
## [353] 11.68420 11.68697 11.69000 11.69330 11.69688 11.70073 11.70485 11.70924
## [361] 11.71390 11.71883 11.72404 11.72952 11.73527 11.74129 11.74758 11.75415
## [369] 11.76099 11.76811 11.77549 11.78315 11.79109 11.79929 11.80778 11.81653
## [377] 11.82556 11.83486 11.84444 11.85429 11.86442 11.87482 11.88549 11.89644
## [385] 11.90767 11.91917 11.93095 11.94300 11.95533 11.96793 11.98081 11.99397
## [393] 12.00740 12.02111#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 394)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 12.04686 12.04033 12.03391 12.02759 12.02137 12.01525 12.00923 12.00330
## [9] 11.99748 11.99175 11.98611 11.98058 11.97513 11.96978 11.96453 11.95937
## [17] 11.95429 11.94932 11.94443 11.93963 11.93492 11.93030 11.92577 11.92132
## [25] 11.91697 11.91270 11.90851 11.90441 11.90039 11.89646 11.89261 11.88884
## [33] 11.88515 11.88154 11.87801 11.87457 11.87120 11.86790 11.86469 11.86155
## [41] 11.85849 11.85551 11.85259 11.84978 11.84710 11.84454 11.84210 11.83978
## [49] 11.83759 11.83551 11.83355 11.83171 11.82998 11.82837 11.82687 11.82548
## [57] 11.82421 11.82304 11.82198 11.82102 11.82017 11.81943 11.81878 11.81824
## [65] 11.81780 11.81745 11.81721 11.81706 11.81700 11.81704 11.81717 11.81739
## [73] 11.81770 11.81810 11.81858 11.81916 11.81981 11.82055 11.82137 11.82227
## [81] 11.82326 11.82431 11.82545 11.82666 11.82795 11.82928 11.83063 11.83201
## [89] 11.83342 11.83487 11.83635 11.83788 11.83946 11.84109 11.84277 11.84451
## [97] 11.84632 11.84820 11.85015 11.85217 11.85428 11.85647 11.85875 11.86113
## [105] 11.86360 11.86618 11.86886 11.87165 11.87455 11.87758 11.88073 11.88400
## [113] 11.88741 11.89095 11.89463 11.89846 11.90243 11.90656 11.91084 11.91528
## [121] 11.91989 11.92467 11.92962 11.93474 11.94005 11.94555 11.95209 11.96036
## [129] 11.97015 11.98122 11.99335 12.00631 12.01987 12.03381 12.04790 12.06190
## [137] 12.07560 12.08877 12.10117 12.11258 12.12277 12.13153 12.14117 12.15398
## [145] 12.16962 12.18778 12.20812 12.23032 12.25405 12.27898 12.30479 12.33115
## [153] 12.35774 12.38422 12.41027 12.43557 12.45978 12.48258 12.50365 12.52266
## [161] 12.53927 12.55317 12.56403 12.57371 12.58427 12.59561 12.60767 12.62035
## [169] 12.63357 12.64726 12.66134 12.67572 12.69033 12.70507 12.71988 12.73467
## [177] 12.74937 12.76388 12.77813 12.79204 12.80552 12.81851 12.83091 12.84264
## [185] 12.85363 12.86380 12.87306 12.88133 12.88853 12.89459 12.89941 12.90293
## [193] 12.90505 12.90570 12.90480 12.90227 12.89731 12.88937 12.87871 12.86560
## [201] 12.85031 12.83311 12.81427 12.79406 12.77274 12.75059 12.72788 12.70487
## [209] 12.68183 12.65904 12.63676 12.61525 12.59480 12.57567 12.55812 12.54243
## [217] 12.52886 12.51438 12.49610 12.47454 12.45021 12.42363 12.39532 12.36580
## [225] 12.33558 12.30518 12.27512 12.24590 12.21806 12.19210 12.16854 12.14790
## [233] 12.13070 12.11486 12.09802 12.08029 12.06178 12.04260 12.02286 12.00266
## [241] 11.98212 11.96133 11.94042 11.91948 11.89862 11.87796 11.85759 11.83763
## [249] 11.81819 11.79937 11.78129 11.76404 11.74774 11.73249 11.71816 11.70450
## [257] 11.69146 11.67897 11.66699 11.65546 11.64432 11.63352 11.62301 11.61273
## [265] 11.60262 11.59263 11.58271 11.57280 11.56284 11.55279 11.54258 11.53217
## [273] 11.52149 11.51049 11.49912 11.48803 11.47786 11.46854 11.45998 11.45212
## [281] 11.44489 11.43820 11.43198 11.42616 11.42067 11.41542 11.41035 11.40537
## [289] 11.40042 11.39543 11.39030 11.38498 11.37938 11.37344 11.36707 11.36021
## [297] 11.35267 11.34441 11.33554 11.32618 11.31642 11.30640 11.29621 11.28597
## [305] 11.27580 11.26580 11.25609 11.24678 11.23799 11.22981 11.22238 11.21579
## [313] 11.21016 11.20561 11.20224 11.19944 11.19652 11.19353 11.19051 11.18748
## [321] 11.18450 11.18159 11.17879 11.17614 11.17368 11.17145 11.16947 11.16780
## [329] 11.16646 11.16550 11.16494 11.16484 11.16521 11.16611 11.16758 11.16963
## [337] 11.17232 11.17533 11.17833 11.18136 11.18449 11.18774 11.19117 11.19482
## [345] 11.19873 11.20295 11.20752 11.21250 11.21792 11.22383 11.23027 11.23729
## [353] 11.24475 11.25247 11.26046 11.26872 11.27726 11.28609 11.29520 11.30461
## [361] 11.31431 11.32432 11.33464 11.34527 11.35622 11.36750 11.37910 11.39103
## [369] 11.40330 11.41592 11.42888 11.44220 11.45587 11.46991 11.48431 11.49909
## [377] 11.51424 11.52978 11.54582 11.56246 11.57967 11.59742 11.61568 11.63442
## [385] 11.65361 11.67323 11.69323 11.71360 11.73429 11.75529 11.77655 11.79806
## [393] 11.81977 11.84167#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")